home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / turbovis / dlgds411.zip / READSCPT.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-02  |  17KB  |  688 lines
  1. {$A-,B-,E+,F-,G-,I+,N-,O-,P-,Q-,R-,S-,T-,V-,X+}
  2.  
  3. Unit ReadScpt;
  4.  
  5. Interface
  6.  
  7. uses Dos, Objects;
  8.  
  9. const
  10.   MaxParam = 6;   {number of extra parameters}
  11. Type
  12.   {various types of controls which may be found in script file. -1 indicates
  13.    end}
  14.   RecType = (Dlg, Button, SText, CText, InputL, Labl, Histry, ILong, CheckB,
  15.              RadioB, MultiCB, ListB, Memo, ScrollB);
  16.   {various types of validators for TInputLine}
  17.   ValType = (Picture, Range, Filter, StringLookup);
  18.  
  19.   BlockType = record   {all controls have this standard data block}
  20.     BaseObj,            {like TInputLine}
  21.     Obj : PString;      {like PInputLine or PMyInputLine}
  22.     X1, Y1, X2, Y2,     {the TRect}
  23.     DefOptns, Optns,    {default and actual options for control}
  24.     DefEvMsk, EvMsk,    {default and actual eventmask for control}
  25.     HCtx,               {HelpCtx value}
  26.     Grow : integer;     {GrowMode value}
  27.     Param : array[1..MaxParam] of PString;    {possible the extra parameters}
  28.     HelpCtxSym,         {like hcNoContext}
  29.     FieldName,          {field name you chose for data record}
  30.     VarName : PString;  {variable name you chose or 'Control'}
  31.     end;
  32.  
  33.   ScriptRec = record  {the variant record for the various controls}
  34.     MainBlock : BlockType;  {the fixed part for all controls}
  35.     case Kind: RecType of
  36.       Dlg:  (Palette, WinFlags : word;    {the dialog itself}
  37.              DlgFuncName,        {like MakeDialog}
  38.              KeyString,          {ID string for resource}
  39.              Title : PString;);  {dialog title}
  40.       Button:
  41.             (CommandName,           {like cmOK}
  42.              ButtonText : PString;  {like O~k~}
  43.              CommandValue,          {word value for Command}
  44.              Flags : word;);        {flags}
  45.       SText, CText:               {static and colored text}
  46.             (Attrib : word;
  47.              Text : PString;);
  48.       InputL:
  49.             (StringLeng : word;     {AMaxLen parameter}
  50.              ValPtrName : PString;  {like PPXPictureString}
  51.              case ValKind : ValType of    {ValKind = -1 if no validator}
  52.                Picture:
  53.                   (AutoFill : Byte;
  54.                    PictureString : PString;);
  55.                Range:
  56.                   (LowLim, UpLim : LongInt;
  57.                    Transfer : word;);    {non-zero if voTransfer bit set}
  58.                StringLookUp:
  59.                   (List : PString;);
  60.                Filter:
  61.                   (CharSet : PString;     {like "['a'..'z', '0'..'9']" }
  62.                    {following represents the actual character set}
  63.                    ActualCharSet : array[0..7] of LongInt;
  64.                   );
  65.              );
  66.       ILong:
  67.             (LongLabelText : PString; {text of the label--not used in Pascal}
  68.              LongStrLeng : word;      {AMaxlen parameter}
  69.              LLim, ULim : LongInt;
  70.              ILOptions : word;);
  71.       LabL: (LabelText,
  72.              LinkName : PString;);    {variable name of control to which
  73.                                        label is linked, often just 'Control'}
  74.       Histry:
  75.             (HistoryID : word;
  76.              HistoryLink : PString;); {variable name of control to which
  77.                                        label is linked, often just 'Control'}
  78.  
  79.       CheckB, RadioB, MultiCB:
  80.             (Items : word;         {number of labels}
  81.              Mask : LongInt;
  82.              LabelColl : PStringCollection;  {collection of labels}
  83.              MCBFlags : word;      {multi checkbox flags}
  84.              SelRange : byte;      {multi checkbox SelRange}
  85.              States : PString;);   {multi checkbox States}
  86.       ListB:
  87.             (Columns : word;
  88.              ScrollBar : PString;);   {variable name of scrollbar}
  89.       Memo: (TextFieldName : PString; {the second DataRec fieldname required by TMemo}
  90.              BufSize : word;          {size of buffer}
  91.              VScroll, HScroll : PString;);   {variable name of scrollbars}
  92.     end;
  93.   PScriptRec = ^ScriptRec;
  94.  
  95.   BitFunction = function(W : word): string;
  96.  
  97. var
  98.   P, Dialog : PScriptRec;
  99.   ScriptColl : PCollection;
  100.   Present : array[Dlg..ScrollB] of boolean; {which types are present}
  101.  
  102. const
  103.   ValidatorPresent : boolean = False;
  104.  
  105. procedure ChkIOerror(S : string);
  106. {main script reading procedure}
  107. procedure ReadScriptFile(FName : string);
  108. {given a byte, word, longint, return the string hex equivalent}
  109. function Hex2(B : Byte) : String;
  110. function Hex4(W : word) : string;
  111. function Hex8(L : LongInt) : string;
  112. {compare two strings without regard to case}
  113. function SameString(const S1, S2 : String) : Boolean;
  114.  
  115. {if the  filename has no extension, add the default extension}
  116. function DefaultExt(const FName, DefExt : string) : string;
  117.  
  118. {functions use by OptionStr}
  119. function GetWinFlagWords(W : word): string;
  120. function GetEventWords(W : word): string;
  121. function GetOptionWords(W : word): string;
  122.  
  123. {given default and actual options (or eventmask), come up with a source
  124.  code phrase something like 'or ofFramed and not ofSelectable'.   Func is
  125.  a function appropriate to the type of bits being looked at.
  126.  It's known that Actual and Default are not equal on entry}
  127. function OptionStr(Actual, Default : word; Func : BitFunction): string;
  128.  
  129. Implementation
  130.  
  131. Const
  132.   VersionID = 'SCRIPT1';
  133.   Tab = #9;
  134.  
  135. type
  136.   PairType = array[0..1] of Char;   {reads two characters at once}
  137.  
  138. var
  139.   Spair : PairType;
  140.   LCh : Char absolute SPair;  {same address as SPair so LCh = Spair[0]}
  141.   Chi, LineNo : integer;
  142.   St : String;
  143.   Inf : Text;
  144.   L : LongInt;
  145.  
  146. function GetWinFlagWords(W : word): string;
  147. const
  148.   FlagArray : array[0..3] of String[7] =
  149.        ('wfMove', 'wfGrow', 'wfClose', 'wfZoom');
  150. var
  151.   S : string;
  152.   I : integer;
  153. begin
  154. S := '';
  155. for I := 0 to 3 do
  156.   begin
  157.   if (W and 1 = 1) then
  158.     S := S+FlagArray[I] + ' or ';
  159.   W := W shr 1;
  160.   end;
  161. if Length(S) > 4 then Dec(S[0], 4);  {remove last ' or '}
  162. GetWinFlagWords := S;
  163. end;
  164.  
  165. function GetEventWords(W : word): string;
  166. const
  167.   FlagArray : array[0..15] of String[11] =
  168.        ('evMouseDown', 'evMouseUp', 'evMouseMove', 'evMouseAuto',
  169.         'evKeyDown', '$20', '$40', '$80', 'evCommand', 'evBroadcast',
  170.         '$400', '$800', '$1000', '$2000', '$4000', '$8000');
  171. var
  172.   S : string;
  173.   I : integer;
  174. begin
  175. S := '';
  176. for I := 0 to 15 do
  177.   begin
  178.   if (W and 1 = 1) and (FlagArray[I] <> '') then
  179.     S := S+FlagArray[I] + ' or ';
  180.   W := W shr 1;
  181.   end;
  182. if Length(S) > 4 then Dec(S[0], 4);  {remove last ' or '}
  183. GetEventWords := S;
  184. end;
  185.  
  186. function GetOptionWords(W : word): string;
  187. const
  188.   FlagArray : array[0..15] of String[13] =
  189.        ('ofSelectable', 'ofTopSelect', 'ofFirstClick', 'ofFramed',
  190.         'ofPreProcess', 'ofPostProcess', 'ofBuffered', 'ofTileable',
  191.         'ofCenterX', 'ofCenterY', 'ofValidate', '$800', 'ofVersion20',
  192.         '$2000', '$4000', 'ofShoehorn');
  193. var
  194.   S : string;
  195.   I : integer;
  196. begin
  197. S := '';
  198. for I := 0 to 15 do
  199.   begin
  200.   if (W and 1 = 1) and (FlagArray[I] <> '') then
  201.     S := S+FlagArray[I] + ' or ';
  202.   W := W shr 1;
  203.   end;
  204. if Length(S) > 4 then Dec(S[0], 4);  {remove last ' or '}
  205. GetOptionWords := S;
  206. end;
  207.  
  208. function BitCount(W : word): integer;  {number of set bits in W}
  209. var
  210.   I, Count : integer;
  211. begin
  212. Count := 0;
  213. for I := 0 to 15 do
  214.   begin
  215.   if W and 1 = 1 then
  216.     Inc(Count);
  217.   W := W shr 1;
  218.   end;
  219. BitCount := Count;
  220. end;
  221.  
  222. function OptionStr(Actual, Default : word; Func : BitFunction): string;
  223. {given default and actual options (or eventmask), come up with a source
  224.  code phrase something like 'or ofFramed and not ofSelectable'.   Func is
  225.  a function appropriate to the type of bits being looked at.
  226.  It's known that Actual and Default are not equal on entry}
  227. var
  228.   S : string;
  229.   NOTs, ORs, Diff : word;
  230. begin
  231. Diff := Actual xor Default;  {the bits that are different}
  232. if BitCount(Diff) > 4 then
  233.   begin   {this is too complex--output hex number}
  234.   OptionStr := '$'+Hex4(Actual)+';';
  235.   Exit;
  236.   end;
  237. NOTs := Diff and Default;  {the bits not in default}
  238. ORs := Diff and Actual;    {the extra bits in actual}
  239. S := '';
  240. if NOTs <> 0 then
  241.   if BitCount(NOT